home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / tsr.swg / 0026_Grab A $13-Image TSR.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-24  |  1.3 KB  |  70 lines
  1.  
  2. {$m $800,0,0 }
  3.  
  4. program catch; { just for Swag }
  5.  
  6. uses crt, dos;
  7.  
  8. const header : array[1..2] of word = (320, 200);
  9.  
  10. var cnt : byte;
  11.  
  12. {$f+}
  13. procedure new_int; interrupt;
  14.  
  15. var imgfile : file;
  16.     imgname : string[12];
  17.  
  18. begin
  19.  str(cnt, imgname);
  20.  if cnt < 10  then imgname := '0'+imgname;
  21.  if cnt < 100 then imgname := '0'+imgname;
  22.  imgname := 'grab.'+imgname;
  23.  
  24.  {$i-}
  25.  assign(imgfile, imgname);
  26.  rewrite(imgfile, 1);
  27.  
  28.  blockwrite(imgfile, header, 4);
  29.  blockwrite(imgfile, mem[$a000:$0], 320*200);
  30.  
  31.  close(imgfile);
  32.  {$i+}
  33.  
  34.  if ioresult <> 0 then
  35.   begin
  36.    sound(1000); { Error }
  37.    delay(1000);
  38.    nosound;
  39.   end
  40.  else
  41.   begin
  42.    sound(50); { Ok! }
  43.    delay(50);
  44.    nosound;
  45.    inc(cnt);
  46.   end;
  47. end;
  48. {$f-}
  49.  
  50.  
  51. begin
  52.  cnt := 1;
  53.  
  54.  setintvec($5, addr(new_int));
  55.  
  56.  writeln('Press Screen Print to grab a 320x200x256 image to "grab.###"');
  57.  writeln('One short low beep means "No error", a long high one means trouble');
  58.  writeln;
  59.  writeln('Only catch when you''re sure:');
  60.  writeln('∙Your hard-disk is not busy');
  61.  writeln('∙You''re in a program (so not at the command-prompt)');
  62.  writeln('∙You''re in the mcga 320x200 256 color modus ($13)');
  63.  
  64.  keep(0);
  65. end.
  66.  
  67. Warning!
  68. Do NOT run this program from within Tp!
  69. Just compile it, then run it as an executable.
  70.